perm filename PICX.F4[PIC,LCS] blob
sn#085794 filedate 1974-02-03 generic text, type T, neo UTF8
00100 SUBROUTINE READR(NNW)
01000 COMMON JXX(4000),JCNT
01100 COMMON/COMMAC/FLINE,LLINE,LSIDE,RSIDE,NEWEND
01200
01400 INTEGER FLINE,RSIDE,FILE
01500 CC LOGICAL FUNCTION ADMISS
01600 CC ADMISS(DTA)=DTA.EQ.-7.OR.(1.LE.DTA.AND.DTA.LE.10)
03500 READ(1) JCNT,(JXX(K),K=1,JCNT),FLINE,LLINE,LSIDE,RSIDE
03600 END
06170 SUBROUTINE PLOU(NWW)
06200 COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
06300 1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
06400 C KA-D IS FOR INVIS. INNER AREA. IA-D IS FOR INVIS. OUTER AREA.
06500
06510 COMMON/CLR/KP,KQ,KR,KS,P/MEDGE/MC,MD,RMC,MMD
06600 COMMON/DDP/IDP1(4000),INP(10,20)/FU/FUJ(512),JJX,RDIV,ADML
06900 COMMON/COMMAC/FLINE,LLINE,LSIDE,RSIDE,NEWEND
07100 INTEGER FLINE,RSIDE
07200 DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/
07250 NEWEND=NWW
07300 IF(NEWEND)GO TO 6002
07400 IF(NEWX)GO TO 1
07500 RTO=6
08000 NX=0
08100 NY=0
08200
08300 1001 FORMAT(A1,3F)
08400 1000 FORMAT(' D, P, S, M OR T HORZ.%,VRT.%, ROTATION'/)
08500 6100 FORMAT(' INNER CLEAR AREA L-R-BT-TP% OUTER L-R-B-T%
08600 1 REV=1, INV=1 OTHER CLEAR AREA'/)
08700 6001 FORMAT(14F)
08800 1 CALL JZERO
08900 JX=0
09000 JY=0
09100 CONST=0
09200 TYPE 1000
09250 C C=CLEAR, T=TYPE INPUT, R=RETURN TO MAIN.
09300 ACCEPT 1001,WHICH,RLR,RUD,ROT
09305 IF(WHICH.EQ.'R')RETURN
09310 IF(WHICH.NE.'C')GO TO 24
09320 NEWX=0
09330 GO TO 1
09400 24 IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
09500 REREAD 3,(INP(NA,NCNT),NA=1,10)
09600 IF(WHICH.NE.'H')GO TO 8002
09700 TYPE 9002
09800 GO TO 1
09900 9002 FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
10000 1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
10100 8002 IF(WHICH.NE.'T')GO TO 3002
10110 6002 TYPE 91,RDIV,JJX
10155 91 FORMAT(' CENTR=',F6.2,' STEP=',I2)
10200 DO 4002 K=1,NCNT
10300 4002 TYPE 5002,(INP(NA,K),NA=1,10)
10400 IF(NEWEND)RETURN
10500 GO TO 1000
10600 3002 IF(WHICH.EQ.'M')GO TO 3102
10700 TYPE 6100
10800 ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
10805 C TYPE -1 TO REPEAT LAST INPUT
10810 IF(A.GE.0)GO TO 33
10820 C REPEATS LAST INPUT
10823 A=AA
10826 B=BB
10829 C=CC
10832 D=DD
10835 E=EE
10838 F=FF
10841 G=GG
10844 H=HH
10847 REV=RREV
10850 RINV=RRINV
10853 P=PP
10856 Q=QQ
10859 R=RR
10862 S=SS
10865 33 AA=A
10868 BB=B
10871 CC=C
10874 DD=D
10877 EE=E
10880 FF=F
10883 GG=G
10886 HH=H
10889 RREV=REV
10892 RRINV=RINV
10893 SS=S
10895 PP=P
10898 QQ=Q
10899 RR=R
10900 IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
11000 REREAD 3,(INP(NA,NCNT),NA=1,10)
11100 3102 JPL=3
11200 WX=WHICH
11300 C SO IT WON'T COUNT RETRIES.
11400 3 FORMAT(10A5)
11500 5002 FORMAT(1X10A5)
11600 C FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
11700 C-- D 0 0 0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
11800 C TYPE 'T' TO GET BACK ALL INPUT LINES.
11900 IF(A+B+C+D.EQ.0)A=-1.
12100 IF(WHICH.NE.'S')GO TO 7002
12400 7002 IF(WHICH.EQ.'M')GO TO 2002
12500 IF(E+H+F+G.EQ.0)E=-1.
12510 IF(P+Q+R+S.EQ.0)P=-1.
12600 IF(RLR.EQ.0)RLR=100.
12700 IF(RUD.EQ.0)RUD=100.
12800 IF(ROT.EQ.1)RINV=RINV-1
12900 2002 RLR=RLR/100.
13000 RUD=RUD/100.
13100 PLT=0
13200 IF(WHICH.NE.'D')GO TO 1002
13300 C DPY IS 1/3 SIZE OF PLOT.
13400 GO TO 2000
13500
13600 1102 IF(WHICH.NE.'M')GO TO 1
13700 C MOVE PEN, L-R%, U-D
13800 2200 RX=JMC
13900 RY=JMD
14000 NX=RX*RLR
14100 NY=RY*RUD
14200 RLR=.01
14300 RUD=.01
14400 GO TO 67
14500
14600 1002 IF(WHICH.NE.'P')GO TO 1102
14800
14900 2000 IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
15000 67 MA=0
15100 MB=0
15200 MC=(RSIDE-LSIDE)*RTO*RLR+.5
15300 MD=(LLINE-FLINE)*RTO*RUD+.5
15310 JREV=MC/JPL
15355 JINV=MD/JPL
15400 JM=-380
15500 KM=-200
15600 IF(NEWX)GO TO 655
15700 JMC=MC
15800 JMD=MD
15900 655 JQX=NX
16000 JQY=NY
16100 IF(WHICH.EQ.'M')GO TO 671
16600 CC JREV=(JA+JC)/JPL
16700 C JINV=(JB+JD)/JPL
16800 KA=0
16900 KB=0
17000 KC=0
17100 KD=0
17110 KP=0
17120 KQ=0
17130 KR=0
17140 KS=0
17200 IA=-1
17300 IB=99999
17400 IC=-1
17500 ID=99999
17600 671 IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
17700 CALL SETPOG(1)
17800 CALL TYPLOC(-300,-611)
17900 CALL DPYBRT(6)
18000 JX=NX/JPL
18100 JY=NY/JPL
18200 CALL AIVECT(-380,-200)
18300 672 JA=0
18400 JB=0
18500 NC=MC/JPL
18600 ND=MD/JPL
18650 CALL DSTORT(JPL)
18700 CALL LINES(3)
18800 CC CALL JZERO
18900 JA=NC
19000 JB=0
19100 CALL LINES(2)
19200 JA=NC
19300 JB=ND
19400 CALL LINES(2)
19500 JB=ND
19600 JA=0
19700 CALL LINES(2)
19800 JA=0
19900 JB=0
20000 CALL LINES(2)
20100 CALL DPYOUT(1)
20200 IF(WHICH.NE.'M')GO TO 2683
20300 168 NY=JQY
20400 NX=JQX
20500 GO TO 1
20600 2683 NQ=0
20700 IF(A)GO TO 1683
20800 KA=MC*(A/100.)
20900 KB=MC*(B/100.)
21000 KC=MD*(C/100.)
21100 KD=MD*(D/100.)
21200 CALL INVIS(KA,KB,KC,KD,NQ)
21210 1683 IF(P)GO TO 9683
21220 KP=MC*(P/100.)
21230 KQ=MC*(Q/100.)
21240 KR=MD*(R/100.)
21250 KS=MD*(S/100.)
21260 CALL INVIS(KP,KQ,KR,KS,NQ)
21300 9683 IF(E)GO TO 8683
21400 IA=MC*(E/100.)
21500 IB=MC*(F/100.)
21600 IC=MD*(G/100.)
21700 ID=MD*(H/100.)
21800 CALL INVIS(IA,IB,IC,ID,NQ)
21900 IF(PLT.EQ.0)E=-1
22000 8683 IF(PLT.NE.0)JPL=1
22100 KA=KA/JPL
22200 KB=KB/JPL
22300 KC=KC/JPL
22400 KD=KD/JPL
22410 KP=KP/JPL
22420 KQ=KQ/JPL
22430 KR=KR/JPL
22440 KS=KS/JPL
22500 IA=IA/JPL
22600 IB=IB/JPL
22700 IC=IC/JPL
22800 ID=ID/JPL
22900 TYPE 683
23000 683 FORMAT(' OK?'/)
23100 ACCEPT 1001,NA
23200 IF(NA.EQ.'N')GO TO 168
23300 JX=NX/JPL
23400 JY=NY/JPL
23500 CC IF(PLT.NE.0)GO TO 1681
23600 6852 CALL CLRPOG(2)
23700 CALL SETPOG(1)
23800 CC JA=-380
23900 CC JB=-200
24000 CALL JZERO
24100 CALL AIVECT(-380,-200)
26800 685 JAR=0
26900 JBR=0
27000 JREV=MC/JPL
27100 JINV=MD/JPL
27200 IF(CONST)PLT=-2
27210 CALL DSTORT(JPL)
27300 CALL PLTMAN
27400 NEWX=-1
27500 NX=JQX
27600 NY=JQY
27700 WX=0
27900 END